home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
edit
/
ae_14.zip
/
SPLIT.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-03-12
|
7KB
|
199 lines
program split ;
{-----------------------------------------------------------------------------}
{ SPLIT -- utility to split text files into smaller chunks }
{ syntax: SPLIT <filename> [<chunksize>] }
{ chunksize can be given in bytes or in k }
{ file name of chunks is same as input file }
{ file extension of chunks is '.000', '.001', '.002' etc. }
{-----------------------------------------------------------------------------}
{$M 16348,65535,65535}
{$B-}
{$I-}
uses Crt,Dos ;
const Version = '1.0' ;
Date = '12 Mar 1991' ;
MaxWord = 65535 ; { maximum chunk size }
DefaultChunkSize = 60000 ;
var InFile, OutFile : file ;
InFileName, OutFileName : PathStr ;
DiskError : word ;
ChunkSize, ChunkNr : longint ;
ChunkSizeStr : string ; { string representation of ChunkSize }
ChunkNrStr : string[3] ; { string representation of ChunkNr }
code : integer ; { result of string->number conversion }
BufPtr : pointer ;
FileDir : DirStr ; { directory part of InFileName }
FileName : NameStr ; { file name part of InFileName }
FileExt : ExtStr ; { file extension part of InFileName }
Ready : boolean ;
Answer : char ; { overwrite existing output file? }
BytesRead,BytesWritten : integer ;
EF : char ; { end-of-file character }
{-----------------------------------------------------------------------------}
{ Indicates whether a filename contains wildcard characters }
{-----------------------------------------------------------------------------}
function Wildcarded (Name : PathStr) : boolean ;
begin
Wildcarded := (Pos('*',Name) <> 0) or (Pos('?',Name) <> 0) ;
end ;
{-----------------------------------------------------------------------------}
{ Returns True if the file <FileName> exists, False otherwise. }
{-----------------------------------------------------------------------------}
function Exists (FileName : PathStr) : boolean ;
var SR : SearchRec ;
begin
FindFirst (FileName,ReadOnly + Hidden + SysFile,SR) ;
Exists := (DosError = 0) and (not Wildcarded(Filename)) ;
end ;
{-----------------------------------------------------------------------------}
{ Reads the result of the last I/O operation into the DiskError variable }
{ and produces an error message if an error has occurred. }
{-----------------------------------------------------------------------------}
procedure CheckDiskError ;
var ErrorText : string ;
begin
DiskError := IOResult ;
if DiskError <> 0
then begin
case DiskError of
2 : ErrorText := 'File not found' ;
3 : ErrorText := 'Path not found' ;
5 : ErrorText := 'File acces denied' ;
101 : ErrorText := 'Disk write error' ;
150 : ErrorText := 'Disk is write-protected' ;
152 : ErrorText := 'Drive not ready' ;
159 : ErrorText := 'Printer out of paper' ;
160 : ErrorText := 'Device write fault' ;
else begin
Str (DiskError,ErrorText) ;
ErrorText := 'I/O error ' + ErrorText ;
end ;
end ; { of case }
Writeln ;
Writeln (Chr(7),ErrorText) ;
end ; { of if }
end ;
{-----------------------------------------------------------------------------}
begin
Writeln ('SPLIT -- utility to split text files into smaller chunks') ;
Writeln ('Version ',Version,' ',Date) ;
Writeln ;
EF := #26 ;
if (ParamCount < 1) or (ParamCount > 2)
then begin
{ wrong number of parameters: give help then quit program }
Writeln ('Use: SPLIT <filename> [<chunksize>]') ;
Exit ; { not nice programming but to prevent huge nesting of ifs }
end ;
if ParamCount = 1
then begin
{ no chunk size given: use default }
ChunkSize := DefaultChunkSize ;
code := 0 ;
end
else begin
ChunkSizeStr := ParamStr(2) ;
if UpCase(ChunkSizeStr[Length(ChunkSizeStr)]) = 'K'
then begin
{ chunk size given in kilobytes }
Val (Copy(ChunkSizeStr,1,Length(ChunkSizeStr)-1),
ChunkSize,code) ;
ChunkSize := ChunkSize * 1024 ;
end
else { chunk size given in bytes }
Val (ChunkSizeStr,ChunkSize,code) ;
end ;
if code <> 0
then begin
{ conversion of chunk size string to number not successful }
Writeln ('Invalid chunk size. Enter number of bytes or') ;
Writeln ('number of kilobytes followed by "k".') ;
Exit ;
end ;
{ decrease ChunkSize with 1 to allow for EOF char }
Dec (ChunkSize) ;
if ChunkSize > MaxWord
then begin
Write ('Invalid chunk size. ') ;
Writeln ('Maximum ',MaxWord,' bytes (or ',MaxWord div 1024,'k)') ;
Exit ;
end ;
InFileName := FExpand (ParamStr(1)) ;
if not Exists(InFileName)
then begin
Writeln ('File "',InFileName,'" not found') ;
Exit ;
end ;
Assign (InFile,InFileName) ;
Reset (InFile,1) ;
CheckDiskError ;
{ allocate memory buffer for contents of file }
GetMem (BufPtr,ChunkSize) ;
ChunkNr := 0 ;
FSplit (InFileName,FileDir,FileName,FileExt) ;
Ready := (DiskError <> 0) ;
while not Ready do
begin
{ construct output file name }
Str (ChunkNr,ChunkNrStr) ;
while Length(ChunkNrStr) < 3 do
ChunkNrStr := '0' + ChunkNrStr ;
OutFileName := FExpand (FileName + '.' + ChunkNrStr) ;
if Exists (OutFileName)
then begin
Write ('File "',OutFileName,'" already exists. ') ;
Write ('Skip/Overwrite/Abort ? (S/O/A) ') ;
repeat Answer := UpCase(ReadKey) ;
if Answer = Chr(0)
then Answer := ReadKey ;
until Answer in ['S','O','A'] ;
Writeln (Answer) ;
end
else Answer := 'O' ;
case Answer of
'S' : { skip }
Inc (ChunkNr) ;
'O' : begin
{ overwrite: read and write chunk }
BlockRead (InFile,BufPtr^,ChunkSize,BytesRead) ;
CheckDiskError ;
Write ('File "',OutFileName,'" ... ') ;
Assign (OutFile,OutFileName) ;
ReWrite (OutFile,1) ;
BlockWrite (OutFile,BufPtr^,BytesRead,BytesWritten) ;
{ write end-of-file char }
BlockWrite (OutFile,EF,1) ;
Close (OutFile) ;
CheckDiskError ;
Writeln (BytesWritten+1,' bytes written.') ;
Ready := (BytesRead <> ChunkSize) or
(BytesWritten <> BytesRead) or
(DiskError <> 0) ;
Inc (ChunkNr) ;
end ;
'A' : { abort }
Ready := True ;
end ; { of case }
Writeln ;
end ; { of while }
Close (InFile) ;
end.